unit uCsbDyn;

interface

uses SysUtils, Windows, Classes, Dialogs, StrUtils;

type
   sword   = smallint;
   dword   = longword;

function GetErrorMessage(status : sword) : string;

function GetLibrary(var LibraryInfo : string; var LibraryPath : string) : sword;
function GetCommList(var CommList : TStringList) : sword;

function OpenReader(var ReaderDevice : string;
                    var ReaderFirmware : string;
                    var ReaderRc500HWID : string;
                    var ReaderRc500SNR : string;
                    var ReaderSettings : dword;
                    var ReaderConsts : dword;
                    var ReaderFeatures : dword) : sword;

function BenchReader(var E128 : dword; var E256 : dword; var E768 : dword) : sword;

function Find(var Uid : string; var Info : string) : sword;

procedure CloseReader;

implementation

type
   T_SPROX_READ_STR = function (str : pchar; str_len : word) : sword; cdecl;
   T_SPROX_READ_DW = function (var val : dword) : sword; cdecl;
   T_SPROX_FIND = function (want_protos: word; var got_protos : word; uid : pointer; var uidlen : byte) : sword; cdecl;

   T_SPROX_GetErrorMessage = function (status : sword) : pchar; cdecl;

   T_SPROX_ControlRF = function (mode : byte) : sword; cdecl;
   T_SPROX_Echo = function (len : sword) : sword; cdecl;
   T_SPROX_ReaderOpen = function (device : pchar) : sword; cdecl;
   T_SPROX_ReaderClose = function : sword; cdecl;
   T_SPROX_ReaderGetRc500Id = function (rc500_type : pointer; rc500_snr : pointer) : sword; cdecl;
   T_SPROX_ReaderSetDeviceSettings = function (settings : dword) : sword; cdecl;

const
   DllNotLoadedStr    : string = 'ERROR : springprox.dll not found or can''t be loaded. Please run the installation procedure again !';
   DllCorruptedStr    : string = 'ERROR : springprox.dll appears to be corrupted. Please run the installation procedure again !';
   ErrorMessageStr    : string = 'ERROR : unsupported error code %d';
   ConnectKODeviceStr : string = 'Reader not found on specified port. Please ensure your device is powered on, and plugged onto the right port.';
   ConnectKOAutoStr   : string = 'Reader not found. Please ensure your device is powered on, and plugged onto a valid computer port.';

var
   DllHandle        : THandle;
   open_proc        : T_SPROX_ReaderOpen;
   close_proc       : T_SPROX_ReaderClose;
   echo_proc        : T_SPROX_Echo;
   controlrf_proc   : T_SPROX_ControlRF;
   find_proc        : T_SPROX_FIND;
   errmsg_proc      : T_SPROX_GetErrorMessage;
   getdev_proc      : T_SPROX_READ_STR;
   getfirm_proc     : T_SPROX_READ_STR;
   getrc_proc       : T_SPROX_ReaderGetRc500Id;
   getlib_proc      : T_SPROX_READ_STR;
   commlist_proc    : T_SPROX_READ_STR;
   rdrset_put_proc  : T_SPROX_ReaderSetDeviceSettings;
   rdrset_get_proc  : T_SPROX_READ_DW;
   rdrfeat_proc     : T_SPROX_READ_DW;
   rdrcnst_proc     : T_SPROX_READ_DW;


procedure LoadSpringProxLibrary;
begin
   if DllHandle = INVALID_HANDLE_VALUE then
   begin
      DllHandle := LoadLibrary('springprox.dll');
   end;
   if DllHandle <> INVALID_HANDLE_VALUE then
   begin
      @getlib_proc      := GetProcAddress(DllHandle, 'SPROX_GetLibraryA');
      @commlist_proc    := GetProcAddress(DllHandle, 'SPROX_GetCommListA');
      @errmsg_proc      := GetProcAddress(DllHandle, 'SPROX_GetErrorMessage');
      @open_proc        := GetProcAddress(DllHandle, 'SPROX_ReaderOpenA');
      @close_proc       := GetProcAddress(DllHandle, 'SPROX_ReaderClose');
      @controlrf_proc   := GetProcAddress(DllHandle, 'SPROX_ControlRF');
      @echo_proc        := GetProcAddress(DllHandle, 'SPROX_Echo');
      @find_proc        := GetProcAddress(DllHandle, 'SPROX_Find');
      @getdev_proc      := GetProcAddress(DllHandle, 'SPROX_ReaderGetDeviceA');
      @getfirm_proc     := GetProcAddress(DllHandle, 'SPROX_ReaderGetFirmwareA');
      @getrc_proc       := GetProcAddress(DllHandle, 'SPROX_ReaderGetRc500Id');
      @rdrset_put_proc  := GetProcAddress(DllHandle, 'SPROX_ReaderSetDeviceSettings');
      @rdrset_get_proc  := GetProcAddress(DllHandle, 'SPROX_ReaderGetDeviceSettings');
      @rdrfeat_proc     := GetProcAddress(DllHandle, 'SPROX_ReaderGetFeatures');
      @rdrcnst_proc     := GetProcAddress(DllHandle, 'SPROX_ReaderGetConsts');
   end;
end;

function OpenReader(var ReaderDevice : string;
                    var ReaderFirmware : string;
                    var ReaderRc500HWID : string;
                    var ReaderRc500SNR : string;
                    var ReaderSettings : dword;
                    var ReaderConsts : dword;
                    var ReaderFeatures : dword) : sword;
var
   buffer           : array[1..257] of char;
   buf1, buf2       : array[1..17] of byte;
   i                : byte;
   rc               : sword;
begin
   ReaderFirmware := '';
   ReaderRc500HWID := '';
   ReaderRc500SNR := '';
   ReaderConsts := 0;
   ReaderFeatures := 0;

   if (@open_proc = nil)
   or (@controlrf_proc = nil)
   or (@getdev_proc = nil)
   or (@getfirm_proc = nil)
   or (@getrc_proc = nil) then
   begin
      result := -1001;
      exit;
   end;
   if @rdrset_put_proc <> nil then
   begin
      rc := rdrset_put_proc(ReaderSettings);
      if (rc <> 0) then
      begin
         result := rc;
         exit;
      end;
   end;
   if length(ReaderDevice) > 0 then
   begin
      rc := open_proc(pchar(ReaderDevice));
   end else
   begin
      rc := open_proc(nil);
   end;
   if rc <> 0 then
   begin
      if length(ReaderDevice) > 0 then
      begin
         result := -1002;
      end else
      begin
         result := -1003;
      end;
      exit;
   end;
   rc := getdev_proc(pchar(@buffer), 256);
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;
   buffer[257] := #0;
   ReaderDevice := StrPas(pchar(@buffer));
   rc := getfirm_proc(pchar(@buffer), 256);
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;
   buffer[257] := #0;
   ReaderFirmware := StrPas(pchar(@buffer));
   rc := getrc_proc(pchar(@buf1), pchar(@buf2));
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;
   for i := 1 to 5 do ReaderRc500HWID := ReaderRc500HWID + Format('%0.2X ', [buf1[i]]);
   for i := 1 to 4 do ReaderRc500SNR  := ReaderRc500SNR  + Format('%0.2X ', [buf2[i]]);
   if @rdrset_get_proc <> nil then
   begin
      rc := rdrset_get_proc(ReaderSettings);
      if (rc <> 0) then
      begin
         result := rc;
         exit;
      end;
   end;
   if @rdrcnst_proc <> nil then
   begin
      rc := rdrcnst_proc(ReaderConsts);
      if (rc <> 0) and (rc <> -100) then
      begin
         result := rc;
         exit;
      end;
   end;
   if @rdrfeat_proc <> nil then
   begin
      rc := rdrfeat_proc(ReaderFeatures);
      if (rc <> 0) and (rc <> -100) then
      begin
         result := rc;
         exit;
      end;
   end;

   result := controlrf_proc(0);
end;

function Find(var Uid : string; var Info : string) : sword;
var
   rc : sword;
   buf : array[1..12] of byte;
   buflen : byte;
   proto : word;
   i : integer;
begin
   if (@find_proc = nil) or (@controlrf_proc = nil) then
   begin
      result := -1001;
      exit;
   end;

   buflen := sizeof(buf);
   rc := find_proc($FFFF, proto, @buf, buflen);
   result := rc;

   if rc = 0 then
   begin
      Uid  := '';
      for i := 1 to buflen do Uid := Uid + IntToHex(buf[i], 2);
      case proto of
        $0001 : Info := 'ISO/IEC 14443-A or NXP Mifare';
        $0002 : Info := 'ISO/IEC 14443-B';
        $0004 : Info := 'ISO/IEC 15693';
        $0008 : Info := 'NXP ICODE1';
        $0010 : Info := 'Inside Contactless PicoTAG';
        $0020 : Info := 'ST MicroElectronics SR';
        $0040 : Info := 'ASK CTS256B or CTS512B';
        $0080 : Info := 'Calypso (Innovatron protocol)';
      else
                Info := 'Unknown type ' + IntToHex(proto, 4);
      end;
   end;

   controlrf_proc(0);
end;

function BenchReader(var E128 : dword; var E256 : dword; var E768 : dword) : sword;
var
   rc     : sword;
   loop   : dword;
   count  : dword;
   t0, t1 : dword;
begin
   result := 0;
   count  := 25;
   E128 := 0;
   E256 := 0;
   E768 := 0;
   if @echo_proc = nil then
   begin
      exit;
   end;

   // Premier essai a 0, c'est surtout pour tester la librairie
   rc := echo_proc(0);
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;

   t0 := GetTickCount;
   for loop := 1 to count do
   begin
      rc := echo_proc(128);
      if rc = -100 then exit; // Pas implemente
      if rc <> 0 then
      begin
         result := rc;
         exit;
      end;
   end;
   t1 := GetTickCount;
   e128 := (t1 - t0) div count;

   t0 := GetTickCount;
   for loop := 1 to count do
   begin
      rc := echo_proc(256);
      if rc = -100 then exit; // Pas implemente
      if rc <> 0 then
      begin
         result := rc;
         exit;
      end;
   end;
   t1 := GetTickCount;
   e256 := (t1 - t0) div count;

   t0 := GetTickCount;
   for loop := 1 to count do
   begin
      rc := echo_proc(768);
      if rc = -100 then exit; // Pas implemente
      if rc = -243 then exit; // Erreur "logique" (protocol)
      if rc = -244 then exit; // Erreur "logique" (NACK)
      if rc <> 0 then
      begin
         ShowMessage(IntToStr(rc));
         result := rc;
         exit;
      end;
   end;
   t1 := GetTickCount;
   e768 := (t1 - t0) div count;
end;


function GetCommList(var CommList : TStringList) : sword;
var
   buffer : array[1..4096] of char;
   rc     : sword;
   s, t   : string;
   p      : integer;
begin
   if DllHandle = 0 then
   begin
      result := -1000;
      exit;
   end;
   if @commlist_proc = nil then
   begin
      result := -1001;
      exit;
   end;
   rc := commlist_proc(pchar(@buffer), sizeof(buffer));
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;
   s := strpas(pchar(@buffer));
   p := pos(#10, s);
   while p > 0 do
   begin
      t := copy(s, 1, p-1);
      CommList.Add(t);
      delete(s, 1, p);
      p := pos(#10, s);
   end;
   result := 0;
end;

function GetLibrary(var LibraryInfo : string; var LibraryPath : string) : sword;
var
   buffer : array[1..257] of char;
   rc     : sword;
begin
   LibraryInfo := '';
   if DllHandle = 0 then
   begin
      result := -1000;
      exit;
   end;
   if GetModuleFileName(DllHandle, pchar(@buffer), sizeof(buffer)) <> 0 then
   begin
      LibraryPath := strpas(pchar(@buffer));
   end else
   begin
      LibraryPath := '???';
   end;
   if @getlib_proc = nil then
   begin
      result := -1001;
      exit;
   end;
   rc := getlib_proc(pchar(@buffer), sizeof(buffer));
   if rc <> 0 then
   begin
      result := rc;
      exit;
   end;
   buffer[257] := #0;
   LibraryInfo := StrPas(pchar(@buffer));
   result := 0;
end;

function GetErrorMessage(status : sword) : string;
var
   rc : pchar;
begin
   if DllHandle = 0 then
   begin
      result := DllNotLoadedStr;
      exit;
   end;
   if @errmsg_proc = nil then
   begin
      result := DllCorruptedStr;
      exit;
   end;
   if status <= -1000 then
   begin
      case status of
      -1000 : result := DllNotLoadedStr;
      -1001 : result := DllCorruptedStr;
      -1002 : result := ConnectKODeviceStr;
      -1003 : result := ConnectKOAutoStr;
      else
         result := Format(ErrorMessageStr, [status]);
      end;
      exit;
   end;
   rc := errmsg_proc(status);
   if rc <> nil then
   begin
      result := StrPas(rc);
   end else
   begin
      result := Format(ErrorMessageStr, [status]);
   end;
end;

procedure CloseReader;
begin
   if DllHandle = 0 then exit;
   if (@controlrf_proc <> nil) then controlrf_proc(0);
   if (@close_proc = nil) then exit;
   close_proc;
end;

initialization
   DllHandle := INVALID_HANDLE_VALUE;
   LoadSpringProxLibrary;
finalization
   CloseReader;
   if DllHandle <> 0 then
   begin
      FreeLibrary(DllHandle);
      DllHandle := 0;
   end;
end.

